home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / netmail / rnr214.zip / RNRNOV.PAS < prev    next >
Pascal/Delphi Source File  |  1995-12-31  |  4KB  |  188 lines
  1. unit rnrnov;
  2.  
  3. {
  4.  
  5. rnrnov.pas - rnr news overview routines (non-re-entrant)
  6.  
  7. }
  8.  
  9. {$I rnr-def.pas}
  10.  
  11. interface
  12.  
  13. uses genericf,rnrglob,rnrconf,rnrfile,rnrio;
  14.  
  15. procedure overviewreset(adir: string);
  16. function eofoverview: boolean;
  17. procedure closeoverview;
  18.  
  19. procedure readoverviewline;
  20. function nextoverviewitem: string;
  21. function readoverviewfilenum: articlefilenametype;
  22.  
  23. {getoverviewheader is _destructive_, alas}
  24. {tag has to end with `:'}
  25. function getoverviewheader(tag: string): string;
  26.  
  27. implementation
  28.  
  29. var
  30.   overviewf: text;
  31.   overviewlines: array[1..maxoverviewlines] of string;
  32.  
  33.  
  34.  
  35. procedure overviewreset;
  36.  
  37. var
  38.   newdir: string;
  39.  
  40. begin
  41.   if overviewbasename='' then
  42.     fileresult := 2  {file not found}
  43.   else
  44.     begin
  45.       newdir := unslash(adir);
  46.       if (right(newdir,1)='\') or (right(newdir,1)=':') then
  47.         newdir := newdir+'.';
  48.  
  49.       safereset(overviewf,withbackslash(newdir)+overviewbasename)
  50.     end;
  51. end;
  52.  
  53. function eofoverview;
  54.  
  55. begin
  56.   eofoverview := eof(overviewf);
  57. end;
  58.  
  59. procedure closeoverview;
  60.  
  61. begin
  62.   close(overviewf);
  63. end;
  64.  
  65.  
  66.  
  67. procedure readoverviewline;
  68.  
  69. var
  70.   i: integer;
  71.  
  72. begin
  73.   for i := 1 to maxoverviewlines do
  74.     overviewlines[i] := '';
  75.  
  76.   for i := 1 to maxoverviewlines do
  77.     begin
  78.       if not eof(overviewf) and not eoln(overviewf) then
  79.         read(overviewf,overviewlines[i]);
  80.     end;
  81.  
  82.   if not eoln(overviewf) then
  83.     xwritelns('overview information overflowed!');
  84.  
  85.   readln(overviewf);
  86. end; {procedure readoverviewline}
  87.  
  88. function nextoverviewitem;
  89.  
  90. var
  91.   result: string;
  92.   ch: char;
  93.   currline: integer;
  94.   tabpos: integer;
  95.   done: boolean;
  96.  
  97. begin
  98.   result := '';
  99.  
  100.   currline := 1;
  101.  
  102.   done := false;
  103.  
  104.   while not done do
  105.     begin
  106.       if length(overviewlines[currline])=0 then
  107.         inc(currline)
  108.       else if currline>maxoverviewlines then
  109.         done := true
  110.       else
  111.         begin
  112.  
  113. {$ifdef old}
  114.           ch := overviewlines[currline][1];
  115.           overviewlines[currline] := copy(overviewlines[currline],2,255);
  116.           if ch=tab then
  117.             done := true
  118.           else
  119.             result := result+ch;
  120. {$endif}
  121.  
  122.           tabpos := pos(tab,overviewlines[currline]);
  123.           if tabpos=0 then
  124.             begin
  125.               result := result+overviewlines[currline];
  126.               overviewlines[currline] := '';
  127.               inc(currline);
  128.             end
  129.           else
  130.             begin
  131.               result := result+copy(overviewlines[currline],1,tabpos-1);
  132.               overviewlines[currline] :=
  133.                copy(overviewlines[currline],tabpos+1,255);
  134.               done := true;
  135.             end;
  136.         end;
  137.     end;
  138.  
  139.   nextoverviewitem := result;
  140. end; {function nextoverviewitem}
  141.  
  142. {for speed only -- cannot use read or next with this}
  143. function readoverviewfilenum;
  144.  
  145. var
  146.   overviewline: string;
  147.   tabpos: integer;
  148.  
  149. begin
  150.   readln(overviewf,overviewline);
  151.   tabpos := pos(tab,overviewline);
  152.   readoverviewfilenum := atol(copy(overviewline,1,tabpos-1));
  153. end;
  154.  
  155. {getoverviewheader is _destructive_, alas}
  156. {tag has to end with `:'}
  157. function getoverviewheader;
  158.  
  159. var
  160.   result: string;
  161.   foundheader: string;
  162.   done: boolean;
  163.   uptag: string;
  164.  
  165. begin
  166.   result := '';
  167.  
  168.   done := false;
  169.   uptag := upper(tag);
  170.  
  171.   while not done do
  172.     begin
  173.       foundheader := nextoverviewitem;
  174.  
  175.       if foundheader='' then
  176.         done := true
  177.       else if upper(copy(foundheader,1,length(tag)))=uptag then
  178.         begin
  179.           result := ltrim(copy(foundheader,length(tag)+1,255));
  180.           done := true;
  181.         end;
  182.     end;
  183.  
  184.   getoverviewheader := result;
  185. end;  {function getoverviewheader}
  186.  
  187. end.
  188.